home *** CD-ROM | disk | FTP | other *** search
/ Young Minds / Young Minds Interactive CD-ROM.ISO / dungeon / ballop.f < prev    next >
Encoding:
Text File  |  1987-09-16  |  2.1 KB  |  103 lines
  1. C BALLOP-    BALLOON FUNCTION
  2. C
  3. C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  4. C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  5. C WRITTEN BY R. M. SUPNIK
  6. C
  7. C DECLARATIONS
  8. C
  9.     LOGICAL FUNCTION BALLOP(ARG)
  10.     IMPLICIT INTEGER (A-Z)
  11.     LOGICAL FINDXT,QEMPTY
  12. #include "parser.h"
  13. #include "gamestate.h"
  14. #include "state.h"
  15. #include "rooms.h"
  16. #include "rflag.h"
  17. #include "curxt.h"
  18. #include "xpars.h"
  19. #include "objects.h"
  20. #include "oflags.h"
  21. #include "oindex.h"
  22. #include "clock.h"
  23.  
  24. #include "verbs.h"
  25. #include "flags.h"
  26. C BALLOP, PAGE 2
  27. C
  28.     BALLOP=.TRUE.
  29. C                        !ASSUME WINS.
  30.     IF(ARG.NE.2) GO TO 200
  31. C                        !READOUT?
  32.     IF(PRSA.NE.LOOKW) GO TO 10
  33. C                        !ONLY PROCESS LOOK.
  34.     IF(BINFF.NE.0) GO TO 50
  35. C                        !INFLATED?
  36.     CALL RSPEAK(543)
  37. C                        !NO.
  38.     GO TO 100
  39. 50    CALL RSPSUB(544,ODESC2(BINFF))
  40. C                        !YES.
  41. 100    IF(BTIEF.NE.0) CALL RSPEAK(545)
  42. C                        !HOOKED?
  43.     RETURN
  44. C
  45. 200    IF(ARG.NE.1) GO TO 500
  46. C                        !READIN?
  47.     IF(PRSA.NE.WALKW) GO TO 300
  48. C                        !WALK?
  49.     IF(FINDXT(PRSO,HERE)) GO TO 250
  50. C                        !VALID EXIT?
  51.     CALL RSPEAK(546)
  52. C                        !NO, JOKE.
  53.     RETURN
  54. C
  55. 250    IF(BTIEF.EQ.0) GO TO 275
  56. C                        !TIED UP?
  57.     CALL RSPEAK(547)
  58. C                        !YES, JOKE.
  59.     RETURN
  60. C
  61. 275    IF(XTYPE.NE.XNORM) GO TO 10
  62. C                        !NORMAL EXIT?
  63.     IF(and(RFLAG(XROOM1),RMUNG).EQ.0) BLOC=XROOM1
  64. 10    BALLOP=.FALSE.
  65.     RETURN
  66. C
  67. 300    IF((PRSA.NE.TAKEW).OR.(PRSO.NE.BINFF)) GO TO 350
  68.     CALL RSPSUB(548,ODESC2(BINFF))
  69. C                        !RECEP CONT TOO HOT.
  70.     RETURN
  71. C
  72. 350    IF((PRSA.NE.PUTW).OR.(PRSI.NE.RECEP).OR.QEMPTY(RECEP))
  73. &        GO TO 10
  74.     CALL RSPEAK(549)
  75.     RETURN
  76. C
  77. 500    IF((PRSA.NE.UNBOAW).OR.(and(RFLAG(HERE),RLAND).EQ.0))
  78. &        GO TO 600
  79.     IF(BINFF.NE.0) CTICK(CEVBAL)=3
  80. C                        !HE GOT OUT, START BALLOON.
  81.     GO TO 10
  82. C
  83. 600    IF((PRSA.NE.BURNW).OR.(OCAN(PRSO).NE.RECEP)) GO TO 700
  84.     CALL RSPSUB(550,ODESC2(PRSO))
  85. C                        !LIGHT FIRE IN RECEP.
  86.     CTICK(CEVBRN)=OSIZE(PRSO)*20
  87.     OFLAG1(PRSO)=or(OFLAG1(PRSO),
  88. &        and((ONBT+FLAMBT+LITEBT), not(TAKEBT+READBT)))
  89.     IF(BINFF.NE.0) RETURN
  90.     IF(.NOT.BLABF) CALL NEWSTA(BLABE,0,0,BALLO,0)
  91.     BLABF=.TRUE.
  92.     BINFF=PRSO
  93.     CTICK(CEVBAL)=3
  94.     CALL RSPEAK(551)
  95.     RETURN
  96. C
  97. 700    IF((PRSA.EQ.UNBOAW).AND.(BINFF.NE.0).AND.
  98. &        (and(RFLAG(HERE),RLAND).NE.0))
  99. &        CTICK(CEVBAL)=3
  100.     GO TO 10
  101. C
  102.     END
  103.